CD Ware Multimedia 1994 November

home *** CD-ROM | disk | FTP | other *** search

/ CD Ware Multimedia 1994 November / Cd Ware (Nro. 2) - Epimundo.iso / DOS / PG / CL_STYLE.ZIP / DOSLIB02.CLA < prev next >

Wrap

Text File | 1994-02-12 | 12.9 KB | 206 lines

MEMBER('DOSLIB') OMIT('╝') ╔════════════════════════════════════════════════════════════════════════════╗ ║ TEMP01.CLA - Internal Source Module ! ║ ╚════════════════════════════════════════════════════════════════════════════╝ Get_Filename Function(DefaultMask,DefaultHeading) Directory STRING(64) ReturnFile STRING(64) FileMask STRING(12) DirQueue QUEUE DirLine STRING(15) . FileQueue QUEUE FileLine STRING(13) . SCREEN SCREEN(17,50),PRE(SCR),SHADOW,EXPAND(9),FALL,CUA,COLOR(112) !dimensions=25,80,25,80 !style=D:\CLARION\DEVELOP\DOSLIB\CLARION.STY ROW(1,1) STRING('█{5}'),COLOR(3) COL(46) STRING('█{5}'),COLOR(3) ROW(4,4) STRING('Directory:'),COLOR(113) ROW(17,1) STRING('█▄{48}█'),COLOR(3) REPEAT(15) ROW(2,1) STRING('█'),COLOR(3) ROW(2,50) STRING('█'),COLOR(3) . ScreenTitle ROW(1,6) STRING(@s40),COLOR(2) ROW(3,4) PROMPT('File&name :'),COLOR(4,5,40,6,7) COL(14) ENTRY(@s12),USE(FileMask),IMM,UPR,OVR,COLOR(8,9,38) ROW(4,14) ENTRY(@s30),USE(Directory),SKIP,COLOR(8,9,38) ROW(6,4) PROMPT('&Files'),COLOR(4,5,40,6,7) ROW(8,4) LIST(8,14),FROM(FileLine),VSCROLL,USE(?FileList),IMM,COLOR(21,22,68) ROW(6,20) PROMPT('Directories'),COLOR(4,5,40,6,7) ROW(8,20) LIST(8,14),FROM(DirLine),VSCROLL,USE(?DirList),IMM,COLOR(21,22,68) ROW(9,38) BUTTON(' &Ok |'),SHADOW,USE(?OK),COLOR(17,18,39,19,20) ROW(12,38) BUTTON(' &Cancel |'),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(17,18,39,19,20) . DirString CSTRING(64) ! Used for Directory to search SaveDir LIKE(DirString) ! Used to hold beginning path SaveSelect LONG ! Used to hold selected field DirInfo GROUP ! Necessary DOS file group BYTE,DIM(21) ! Used by findfirst Attrib BYTE ! Attribute in DOS format DosTime SHORT ! Time in DOS format DosDate SHORT ! Date in DOS format Filesize LONG ! Size in BYTES FileName CSTRING(13) ! File name END ! End GROUP DriveNumber USHORT ! Used for Drive search CheckReady STRING(3) ! Used to check if Drive is ready CODE ! Begin Processing Code OPEN(SCREEN) ! Open the screen If Omitted(2) then Scr:ScreenTitle = Center('Select a File',Size(Scr:ScreenTitle)) Else Scr:ScreenTitle = Center(DefaultHeading,Size(Scr:ScreenTitle)) . If ~Omitted(1) then FileMask = DefaultMask !Set Default Filemask . If Clip(FileMask) = '' then FileMask = '*.*'. !Set the begining file mask SaveDir = PATH() !Save the Starting Directory IF SUB(SaveDir,LEN(CLIP(SaveDir)),1) <> '\' ! Last character not backslash? SaveDir = CLIP(SaveDir) & '\' ! Add the trailing '\' END Directory = SaveDir !Set to the Current Directory DO FillQueues !Fill the screen queues LOOP !Main ACCEPT loop CASE SELECTED() ! Jump to field setup routine END ! End CASE ACCEPT ! ACCEPT keyboard input CASE FIELD() ! Jump to field edit routine OF ?FileMask ! Completed file mask field IF REFER() ! If something was entered Do FillQueues ! Fill queues with new mask END ! End IF OF ?FileList ! FileList field edit GET(FileQueue,CHOICE()) ! Get selected file entry IF KEYCODE() = MouseLeft2 OR | ! On mouse double click KEYCODE() = EnterKey ! Or the Enter Key SELECT(?OK) ! Select the OK button and PRESS(EnterKey) ! Press Enter to complete END ! End IF OF ?DirList ! Directory list field edit IF SELECTED() = ?DirList ! If staying on this field IF KEYCODE() = MouseLeft2 OR | ! On mouse double click KEYCODE() = EnterKey ! or the Enter Key GET(DirQueue,CHOICE()) ! Get the selected entry IF LEN(CLIP(DirLine)) = 5 AND | ! Are we looking at a drive? SUB(DirLine,1,2) = '[-' AND | SUB(DirLine,4,2) = '-]' AND | SUB(DirLine,3,1) >= 'A' AND | SUB(DirLine,3,1) <= 'Z' CheckReady = SUB(DirLine,3,1) & ':' ! Specify drive letter designation IF STATUS(CheckReady) = 0 ! If drive not ready CYCLE ! Don't change to it END Directory = CLIP(CheckReady) ! Assign drive letter as new directory ELSE Directory = CLIP(Directory) & DirLine ! Create a new directory string END IF SUB(Directory,LEN(CLIP(Directory)),1) = '\' ! Last character a backslash? Directory = SUB(Directory,1,LEN(CLIP(Directory))-1) ! Get rid of it before SETPATH END SETPATH(Directory) ! Set to current directory Directory = PATH() ! Reread the current directory IF SUB(Directory,LEN(CLIP(Directory)),1) <> '\' ! Last character not backslash? Directory = CLIP(Directory) & '\' ! Add the trailing '\' for display END Do FillQueues ! Fill the screen queues END ! End IF END ! End IF OF ?Ok ! Ok button field Edit IF FileLine = ' NO MATCH ' ! If no FileName selected SELECT(?DirList) ! Select directory list CYCLE ! Cycle to ACCEPT. END ! End IF ReturnFile = CLIP(Directory) & FileLine ! Save the Filename DO ProcedureReturn ! And leave the Procedure OF ?Cancel ! Cancel button field Edit SETPATH(SaveDir) ! Return to starting path FREE(DirQueue) ! Free the DirQueue memory FREE(FileQueue) ! Free the FileQueue memory CLEAR(ReturnFile) ! Clear the filename variable DO ProcedureReturn ! And leave the Procedure END ! End CASE FIELD() END ! End LOOP DO ProcedureReturn ! And leave the Procedure !───────────────────────────────────────────────────────────────────────────── ProcedureReturn ROUTINE ! return from the PROC SETPATH(SaveDir) !Return to starting path FREE(DirQueue) !Free the DirQueue memory FREE(FileQueue) !Free the FileQueue memory DO EndOfProcedureEmbed ! Process the final EMBED RETURN(ReturnFile) ! END exit the PROC !───────────────────────────────────────────────────────────────────────────── EndOfProcedureEmbed ROUTINE ! Process the final EMBED !───────────────────────────────────────────────────────────────────────────── !───────────────────────────────────────────────────────────────────────────── FillQueues ROUTINE SaveSelect = SELECTED() !Save the current selected field FREE(FileQueue) !Free the FileQueue SELECT(?FileList,1) !Reset file list box FREE(DirQueue) !Free the DirQueue SELECT(?DirList,1) !Reset Dir List box DirString = CLIP(Directory) & '*.*' !Set the subdirectory mask IF NOT LEN(CLIP(DirString)) = 6 !If not in the root directory DirLine = '..\' ! Make prior directory entry ADD(DirQueue) ! Add to the DirQueue END !End IF IF DL:FindFirst(DirString,DirInfo,FA_DIREC) <> 0 !If unexpected error FREE(DirQueue) ! Clear the DirQueue FREE(FileQueue) ! Clear the FileQueue DISPLAY ! Redisplay the lists RETURN('') ! Return END !End IF LOOP !While entries found IF FileName = '.' OR FileName = '..' ! If the dot entries IF DL:FindNext(DirInfo) <> 0 ! Get the next entry BREAK ! Break if unexpected error END ! End IF CYCLE ! Return to dot entry check END ! End IF IF BAND(ATTRIB,10H) ! If a subdirectory is found DirLine = FileName ! Fill the queue field ADD(DirQueue) ! Add to the DirQueue IF ERRORCODE() THEN BREAK. ! Break if unexpected error END ! End IF IF DL:FindNext(DirInfo) <> 0 ! Get the next entry BREAK ! Break if unexpected error END ! End IF END !End LOOP SORT(DirQueue,+DirLine) !Sort the directory listing LOOP DriveNumber = 1 TO 26 !Loop through drive numbers IF DL:IsAValidDrive(DriveNumber) !Validate drive number DirLine = '[-' & CLIP(CHR(DriveNumber-1+VAL('A'))) & '-]' !Format drive letter ADD(DirQueue) ! Add to the DirQueue END END FileLine = 'Searching...' !Search message ADD(FileQueue) !Add to the FileQueue DISPLAY !Display new directory and message FREE(FileQueue) !Free the FileQueue DirString=CLIP(Directory) & FileMask !Set the file mask IF DL:FindFirst(DirString,DirInfo,FA_NORMAL) <> 0 !If no matching files found FileLine = ' NO MATCH ' ! Fill queue with message ADD(FileQueue) ! Add to the FileQueue Else !Else matching file found LOOP ! While entries are found IF BAND(ATTRIB,10H) = 0 ! If entry is a file FileLine = FileName ! Fill the queue field and ADD(FileQueue) ! Add to the FileQueue IF ERRORCODE() THEN BREAK. ! Break if unexpected error END ! End IF IF DL:FindNext(DirInfo) <> 0 ! Get the next entry BREAK ! Break if unexpected error END ! End IF END ! End LOOP END !End IF SORT(FileQueue,+FileLine) !Sort the file listing DISPLAY !Display the new lists SELECT(SaveSelect) !Reselect the previous selected field